#lang sicp
;练习2.1
;有理数的抽象表示
(define (print-rat x)
  (newline)
  (display (car x))
  (display "/")
  (display (cdr x)))

(define (make-rat n d)
  (let ((g (gcd n d)))
    (if (< d 0)
        (cons (/ (* -1 n) g) (/ (* -1 d) g))
        (cons (/ n g) (/ d g)))))

;(print-rat (make-rat 2 3))
;(print-rat (make-rat 2 -3))
;(print-rat (make-rat -2 3))
;(print-rat (make-rat -2 -3))

;------------------------------------------------------
;练习2.2
;线段的抽象表示
;某线段中点
(define (make-segment p1 p2)
  (cons p1 p2))
(define (start-segment l)
  (car l))
(define (end-segment l)
  (cdr l))
(define (make-point x y)
  (cons x y))
(define (x-point p)
  (car p))
(define (y-point p)
  (cdr p))
(define (print-point p)
  (newline)
  (display "(")
  (display (x-point p))
  (display ", ")
  (display (y-point p))
  (display ")"))
(define (midpoint-segment l)
  (let ((p1 (start-segment l))
        (p2 (end-segment l)))
    (let ((p1-x (x-point p1))
          (p1-y (y-point p1))
          (p2-x (x-point p2))
          (p2-y (y-point p2)))
      (make-point (/ (+ p1-x p2-x) 2)
                  (/ (+ p1-y p2-y) 2)))))
;(print-point (midpoint-segment (make-segment (make-point 0. 0.) (make-point 1. 5.))))

;------------------------------------------------------
;练习2.3
;平面矩形的抽象表示
;计算周长,面积
(define (rectangle-perimeter rec)
  (* 2
     (+ (rectangle_width rec)
        (rectangle_height rec))))

(define (rectangle-area rec)
  (* (rectangle_width rec)
     (rectangle_height rec)))

(define (make-rectangle l1 l2)
  (cons l1 l2))
(define (segment-length l)
  (let ((p1 (start-segment l))
        (p2 (end-segment l)))
    (let ((p1-x (x-point p1))
          (p1-y (y-point p1))
          (p2-x (x-point p2))
          (p2-y (y-point p2)))
      (let ((x-diff (- p2-x p1-x))
            (y-diff (- p2-y p1-y)))
        (sqrt (+ (* x-diff x-diff)
                 (* y-diff y-diff)))))))

(define (rectangle_width rec)
  (segment-length (car rec)))
(define (rectangle_height rec)
  (segment-length (cdr rec)))

;(define p1 (make-point 0.0 0.0))
;(define p2 (make-point 2.0 0.0))
;(define p3 (make-point 0.0 0.0))
;(define p4 (make-point 0.0 1.0))
;(define l1 (make-segment p1 p2))
;(define l2 (make-segment p3 p4))
;(define rec (make-rectangle l1 l2))
;(rectangle-perimeter rec)
;(rectangle-area rec)

;------------------------------------------------------
;练习2.4
;序对的过程性表示
(define (f2.4-cons x y)
  (lambda (m) (m x y)))
(define (f2.4-car z)
  (z (lambda (p q) p)))
(define (f2.4-cdr z)
  (z (lambda (p q) q)))

;(f2.4-car (f2.4-cons 1 2))
;(f2.4-cdr (f2.4-cons 1 2))

;-----------------------------------------------------------
;练习2.5
(define (f2.5-cons a b)
  (* (expt 2 a)
     (expt 3 b)))
(define (f2.5-car z)
  (if (= (remainder z 2) 0)
      (+ 1
         (f2.5-car (/ z 2)))
      0))
(define (f2.5-cdr z)
  (if (= (remainder z 3) 0)
      (+ 1
         (f2.5-cdr (/ z 3)))
      0))

;(define l (f2.5-cons 102 3))
;(f2.5-car l)
;(f2.5-cdr l)

;-------------------------------------------
;练习2.6
;Church计数,加,乘,指数基本运算
(define zero (lambda (f) (lambda (x) x)))
(define (add-1 n)
  (lambda (f) (lambda (x) (f ((n f) x)))))
(define (f2.6-f x)
  (+ x 1))
(define (f2.6-n f)
  (lambda (x)
    (f x)))
(define one (lambda (f)
              (lambda (x) (f x))))
(define two (lambda (f)
              (lambda (x) (f (f x)))))
(define three (lambda (f)
              (lambda (x) (f (f (f x))))))
(define f2.6-add (lambda (v1 v2)
                   (lambda (f)
                     (lambda (x)
                       ((v2 f) ((v1 f) x))))))
(define f2.6-multiply (lambda (v1 v2)
                        (lambda (f)
                          (lambda (x)
                            ((v2 (v1 f)) x)))))
(define f2.6-exp (lambda (v1 v2)
                   (lambda (f)
                     (lambda (x)
                       (((v2 v1) f) x)))))

;((zero f2.6-f) 0)
;(((add-1 zero) f2.6-f) 0)
;(((f2.6-add one two) f2.6-f) 0)
;(((f2.6-multiply two two) f2.6-f) 0)
;(((f2.6-exp one two) f2.6-f) 0)

;------------------------------------------------------
;练习2.7
;区间选择符
(define (upper-bound interval)
  (if (> (car interval) (cdr interval))
      (car interval)
      (cdr interval)))
(define (lower-bound interval)
  (if (> (car interval) (cdr interval))
      (cdr interval)
      (car interval)))

;--------------------------------------------------------
;练习2.8
(define (make-interval x y)
  (cons x y))
(define (sub-interval x y)
  (let ((p1 (- (lower-bound x) (lower-bound y)))
        (p2 (- (lower-bound x) (upper-bound y)))
        (p3 (- (upper-bound x) (lower-bound y)))
        (p4 (- (upper-bound x) (upper-bound y))))
    (make-interval (min p1 p2 p3 p4)
                   (max p1 p2 p3 p4))))

;-------------------------------------------------------
;练习2.17
;获取表的最后一个元素
(define (last-pair l)
  (if (null? (cdr l))
      (car l)
      (last-pair (cdr l))))
;(last-pair (list 23 72 149 34))

;------------------------------------------------------
;练习2.18
;获取表的逆序表
(define (reverse l)
  (define (expect-last-pair l)
    (if (null? (cdr l))
        nil
        (cons (car l)
              (expect-last-pair (cdr l)))))
  (if (null? (cdr l))
      l
      (cons (last-pair l)
            (reverse (expect-last-pair l)))))
(define (reverse-iter l)
  (define (iter things answer)
    (if (null? things)
        answer
        (iter (cdr things)
              (cons (car things)
                    answer))))
  (iter l nil))

;(reverse (list 1 4 9 16 25))
;(reverse-iter (list 1 2 3))

;------------------------------------------------------
;2.19
;求取使用指定币种兑换零钱的方式数目
(define (cc amount coin-values)
  (cond ((= amount 0) 1)
        ((or (< amount 0) (no-more? coin-values)) 0)
        (else (+ (cc amount
                     (except-first-denomination coin-values))
                 (cc (- amount
                        (first-denomination coin-values))
                     coin-values)))))

(define (first-denomination coin-values)
  (car coin-values))
(define (except-first-denomination coin-values)
  (cdr coin-values))
(define (no-more? coin-values)
  (null? coin-values))

;(define us-coins (list 50 25 10 5 1))
;(cc 100 us-coins)

;---------------------------------------------------------
;练习2.20
;变长形式参数
(define (same-parity x . y)
  (define (parity f l)
    (if (null? l)
        nil
        (if (f (car l))
            (cons (car l)
                  (parity f (cdr l)))
            (parity f (cdr l)))))
  (define (parity-f v)
    (or (and (= (modulo x 2) 0) (= (modulo v 2) 0))
        (and (= (modulo x 2) 1) (= (modulo v 2) 1))))
  (cons x
        (parity parity-f
                y)))

;(same-parity 2 3 4 5 6 7)

;---------------------------------------------------
;练习2.21
;对表中的每个元素取平方
(define (square-list-1 items)
  (if (null? items)
      nil
      (cons (* (car items)
               (car items))
            (square-list-1 (cdr items)))))
(define (square-list-2 items)
  (map (lambda (x)
         (* x
            x))
       items))
;(square-list-1 (list 1 2 3 4))
;(square-list-2 (list 1 2 3 4))

;------------------------------------------
;练习2.22
;2.21迭代版
(define (square-list-3 items)
  (define (iter things answer)
    (if (null? things)
        answer
        (iter (cdr things)
              (cons (* (car things)
                       (car things))
                    answer))))
  (iter items nil))
;(square-list-3 (list 1 2 3))

;--------------------------------------------
;练习2.23
;for-each实现
(define (for-each f items)
  (if (null? items)
      nil
      (begin
       (f (car items))
       (for-each f (cdr items)))))
(define (f2.23-f x)
  (display x)
  (newline))

;(for-each f2.23-f (list 57 321 88))

;--------------------------------------------
;练习2.24
;(list 1 (list 2 (list 3 4)))

;-----------------------------------------------
;练习2.25
;表操作取7
;(car (cdr (car (cdr (cdr (list 1 3 (list 5 7) 9))))))
;(car (car (list (list 7))))
;(define f2.25-3-list (list 1 (list 2 (list 3 (list 4 (list 5 (list 6 7)))))))
;(car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr f2.25-3-list))))))))))))

;----------------------------------------------------
;练习2.26
(define x (list 1 2 3))
(define y (list 4 5 6))
;(cons x y)
;(list x y)

;-------------------------------------------------------
;练习2.27
;表中子树倒序
(define (deep-reverse items)
  (define (iter things answer)
    (cond ((null? things) answer)
          (else
           (iter (cdr things)
                 (cons (if (pair? (car things))
                           (deep-reverse (car things))
                           (car things))
                       answer)))))
  (iter items nil))

;(reverse  (list (list 1 2 (list 3 4)) (list 5 6 (list 7 8))))
;(deep-reverse (list (list 1 2 (list 3 4)) (list 5 6 (list 7 8))))

;------------------------------------------
;练习2.28
;取树的子叶，从左往右序
(define (fringe tree)
  (cond ((null? tree) nil)
        ((not (pair? tree)) (list tree))
        (else (append (fringe (car tree))
                      (fringe (cdr tree))))))
                        

;(define f2.28-x (list (list 1 2 (list 78 (list 34 56))) (list (list 30 (list 223 100)) 3 4)))
;(fringe f2.28-x)

;-------------------------------------------------
;练习2.29
;二叉活动体
(define (make-mobile left right)
  (cons left right))
(define (make-branch length structure)
  (cons length structure))
;(a
(define (left-branch mobile)
  (car mobile))
(define (right-branch mobile)
  (cdr mobile))
(define (branch-length branch)
  (car branch))
(define (branch-structure branch)
  (cdr branch))
;(b
(define (total-weight mobile)
  (if (not (pair? mobile))
      mobile
      (+ (total-weight (branch-structure (left-branch mobile)))
         (total-weight (branch-structure (right-branch mobile))))))
;(c
(define (balance?-mobile mobile)
  (if (not (pair? mobile))
      #t
      (let ((left-node (left-branch mobile))
            (right-node (right-branch mobile)))
        (let ((left-node-structure (branch-structure left-node))
              (right-node-structure (branch-structure right-node)))
          (and (= (* (branch-length left-node)
                     (total-weight left-node-structure))
                  (* (branch-length right-node)
                     (total-weight right-node-structure)))
               (balance?-mobile left-node-structure)
               (balance?-mobile right-node-structure))))))

;(define branch0 (make-branch 1 2))
;(define branch1 (make-branch 1 1))
;(define mobile1 (make-mobile branch0 branch1))
;(define branch3 (make-branch 1 1))
;(define branch4 (make-branch 1 1))
;(define mobile2 (make-mobile branch3 branch4))
;(define branch5 (make-branch 1 mobile1))
;(define branch6 (make-branch 1 mobile2))
;(define mobile0 (make-mobile branch5 branch6))
;(total-weight mobile0)
;(balance?-mobile mobile0)

;---------------------------------------------
(define (scale-tree tree factor)
  (map (lambda (sub-tree)
         (if (pair? sub-tree)
             (scale-tree sub-tree factor)
             (* sub-tree factor)))
       tree))

;(scale-tree (list 1 (list 2 (list 3 4) 5) (list 6 7)) 10)

;------------------------------------------------------------
;练习2.30
;树的叶子遍历开方并获取表
(define (square-tree tree)
  (cond ((null? tree) nil)
        ((not (pair? tree)) (* tree tree))
        (else (cons (square-tree (car tree))
                    (square-tree (cdr tree))))))
(define (square-tree-map tree)
  (map (lambda (sub-tree)
         (if (pair? sub-tree)
             (square-tree-map sub-tree)
             (* sub-tree sub-tree)))
       tree))

;(square-tree (list 1 (list 2 (list 3 4) 5) (list 6 7)))

;--------------------------------------------------------------
;练习2.31
;map-tree进一步抽象
;直接递归定义
(define (tree-map f tree)
  (cond ((null? tree) nil)
        ((not (pair? tree)) (f tree))
        (else (cons (tree-map f (car tree))
                    (tree-map f (cdr tree))))))
;利用高阶函数map递归定义
(define (tree-map-map f tree)
  (map (lambda (sub-tree)
         (if (pair? sub-tree)
             (tree-map-map f sub-tree)
             (f sub-tree)))
       tree))
(define (square-tree-2.31 tree)
  (tree-map (lambda (x) (* x x)) tree))

;(square-tree-2.31 (list 1 (list 2 (list 3 4) 5) (list 6 7)))

;-----------------------------------------------------------
;练习2.32
;生成某个集合中所有元素的不重复的所有组合的表
(define (subsets s)
  (if (null? s)
      (list nil)
      (let ((rest (subsets (cdr s))))
        (append rest (map (lambda (node)
                            (if (null? node)
                                (list (car s))
                                (cons (car s) node)))
                          rest)))))
;(subsets (list 1 2 3))

;------------------------------------------------------------
;练习2.33
;不同序列操作抽象为累积操作的练习
(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))

(define (f-2.33-map p sequence)
  (accumulate (lambda (x y)
                (cons (p x) y))
              nil
              sequence))

(define (f-2.33-append seq1 seq2)
  (accumulate cons seq2 seq1))

(define (f-2.33-length sequence)
  (accumulate (lambda (x y)
                (+ 1 y))
              0
              sequence))

;(define f2.33-list (list 1 2 3))
;(f-2.33-map (lambda (x) (+ 1 x)) f2.33-list)
;(f-2.33-append (list 1 2 3) (list 4 5 6))
;(f-2.33-length (list 1 2 3))

;-----------------------------------------------------------
;练习2.34
;以累积形式求取给定x和系数的多项式值
(define (horner-eval x coefficient-squence)
  (accumulate (lambda (this-coeff higher-terms)
                (+ this-coeff
                   (* x
                      higher-terms)))
              0
              coefficient-squence))

;(horner-eval 2 (list 1 3 0 5 0 1))

;---------------------------------------------------------------
;练习2.35
;以累积形式获取树的叶子数量
(define (f2.35-count-leaves t)
  (accumulate (lambda (x y)
                (+ (if (not (pair? x))
                       1
                       (f2.35-count-leaves x))
                   y))
              0
              t))

(define (f2.35-count-leaves-map t)
  (accumulate +
              0
              (map (lambda (node)
                     (if (pair? node)
                         (f2.35-count-leaves-map node)
                         1))
                   t)))

;(f2.35-count-leaves-map (list (list 1 2) (list (list 3 (list 4 (list 5 6))))))

;----------------------------------------------------------------
;练习2.36
;嵌套序列的累积抽象
(define (accumulate-n op init seqs)
  (if (null? (car seqs))
      nil
      (cons (accumulate op
                        init
                        (accumulate (lambda (x y)
                                      (cons (car x)
                                            y))
                                    nil
                                    seqs))
            (accumulate-n op
                        init
                        (accumulate (lambda (x y)
                                      (cons (cdr x)
                                            y))
                                    nil
                                    seqs)))))

;(accumulate-n + 0 (list (list 1 2 3) (list 4 5 6) (list 7 8 9) (list 10 11 12)))

;----------------------------------------------------------
;练习2.37
;基本矩阵和向量运算
(define (dot-product v w)
  (accumulate + 0 (map * v w)))
(define (matrix-*-vector m v)
  (map (lambda (x)
         (accumulate +
                     0
                     (map *
                          x
                          v)))
       m))
(define (transpose mat)
  (accumulate-n cons
                nil
                mat))
(define (matrix-*-matrix m n)
  (let ((cols (transpose n)))
    (map (lambda (x)
           (matrix-*-vector cols
                            x))
         m)))

;(define f2.37-matrix (list (list 1 2 3) (list 4 5 6) (list 6 7 8)))
;(matrix-*-vector f2.37-matrix (list 1 1 1))
;(transpose f2.37-matrix)
;(matrix-*-matrix f2.37-matrix f2.37-matrix)

;-----------------------------------------------------------
;练习2.38
;fold-left
(define (fold-left op init seq)
  (define (iter result rest)
    (if (null? rest)
        result
        (iter (op (car rest) result)
              (cdr rest))))
  (iter init seq))
;(accumulate / 1 (list 1 2 3))
;(fold-left / 1 (list 1 2 3))
;(accumulate cons nil (list 1 2 3))
;(fold-left cons nil (list 1 2 3))

;-----------------------------------------------------------------
;练习2.39
;基于2.38实现reverse
(define (f2.39-reverse-v1 seq)
  (accumulate (lambda (x y)
                (append y (list x)))
              nil
              seq))
(define (f2.39-reverse-v2 seq)
  (fold-left (lambda (x y)
               (cons x y))
             nil seq))

;(f2.39-reverse-v1 (list 1 2 3))
;(f2.39-reverse-v2 (list 1 2 3))


;-------------------------------------------------------
(define (flatmap proc seq)
  (accumulate append nil (map proc seq)))

(define (filter proc seq)
  (cond ((null? seq) nil)
        ((proc (car seq)) (cons (car seq)
                                (filter proc (cdr seq))))
        (else (filter proc (cdr seq)))))

(define (remove item seq)
  (filter (lambda (x)
            (not (= x item)))
          seq))

(define (permutations s)
  (if (null? s)
      (list nil)
      (flatmap (lambda (x)
                 (map (lambda (p) (cons x p))
                      (permutations (remove x s))))
               s)))

;(permutations (list 1 2 3))

;----------------------------------------------------------------
;练习2.40
(define (enumerate-interval low high)
  (if (> low high)
      nil
      (cons low (enumerate-interval (+ low 1) high))))

(define (unique-pairs n)
  (flatmap (lambda (i)
             (map (lambda (j) (list i j))
                  (enumerate-interval 1 (- i 1))))
           (enumerate-interval 1 n)))

;(unique-pairs 5)

;--------------------------------------------------------------------
;练习2.41
(define (f2.41-enumerate n)
  (flatmap (lambda (i)
             (flatmap (lambda (j)
                    (map (lambda (k)
                           (list i j k))
                         (enumerate-interval 1 (- j 1))))
                  (enumerate-interval 1 (- i 1))))
           (enumerate-interval 1 n)))
(define (f2.41 n s)
  (filter (lambda (x)
            (= s
               (accumulate +
                           0
                           x)))
          (f2.41-enumerate n)))
;(f2.41-enumerate 5)
;(f2.41 5 10)

;---------------------------------------------------------
;符号求导实例
(define (=number? exp num)
  (and (number? exp) (= exp num)))
(define (variable? e) (symbol? e))
(define (same-variable? v1 v2)
  (and (variable? v1) (variable? v2) (eq? v1 v2)))
(define (sum? e)
  (and (pair? e) (eq? (car e) '+)))
(define (addend e)
  (cadr e))
(define (augend e)
  (caddr e))
(define (make-sum a1 a2)
  (cond ((=number? a1 0) a2)
        ((=number? a2 0) a1)
        ((and (number? a1) (number? a2)) (+ a1 a2))
        (else (list '+ a1 a2))))

(define (product? e)
    (and (pair? e) (eq? (car e) '*)))
(define (multiplier e)
    (cadr e))
(define (multiplicand e)
    (caddr e))
(define (make-product m1 m2)
  (cond ((or (=number? m1 0) (=number? m2 0)) 0)
        ((=number? m1 1) m2)
        ((=number? m2 1) m1)
        ((and (number? m1) (number? m2)) (* m1 m2))
        (else (list '* m1 m2))))

(define (deriv exp var)
  (cond ((number? exp) 0)
        ((variable? exp)
         (if (same-variable? exp var) 1 0))
        ((sum? exp)
         (make-sum (deriv (addend exp) var)
                   (deriv (augend exp) var)))
        ((product? exp)
         (make-sum
          (make-product (multiplier exp)
                        (deriv (multiplicand exp) var))
          (make-product (deriv (multiplier exp) var)
                        (multiplicand exp))))
        (else
         (error "unknown expression type -- DERIV" exp))))
;(deriv '(+ x 3) 'x)
;(deriv '(* x y) 'x)
;(deriv '(* (* x y) (+ x 3)) 'x)

;-------------------------------------------------------------------
;练习2.56
(define (exponentiation? e)
  (and (pair? e) (eq? (car e) '**)))
(define (base e)
  (cadr e))
(define (exponent e)
  (caddr e))
(define (make-expoinentiation e1 e2)
  (cond ((=number? e2 0) 1)
        ((=number? e2 1) e1)
        (else (list '** e1 e2))))
(define (deriv-2.56 exp var)
  (cond ((number? exp) 0)
        ((variable? exp)
         (if (same-variable? exp var) 1 0))
        ((sum? exp)
         (make-sum (deriv-2.56 (addend exp) var)
                   (deriv-2.56 (augend exp) var)))
        ((product? exp)
         (make-sum
          (make-product (multiplier exp)
                        (deriv-2.56 (multiplicand exp) var))
          (make-product (deriv-2.56 (multiplier exp) var)
                        (multiplicand exp))))
        ((exponentiation? exp)
         (make-product (exponent exp)
                       (make-product (make-expoinentiation (base exp)
                                                           (- (exponent exp) 1))
                                     (deriv-2.56 (base exp)
                                            var))))
        (else
         (error "unknown expression type -- DERIV" exp))))

;(deriv-2.56 '(** x 3) 'x)

;----------------------------------------------------------------
;练习2.57
;处理任意项和或乘积的求导
(define (augend-2.57 e)
  (if (null? (cdddr e))
      (caddr e)
      (cons '+ (cddr e))))
(define (multiplicand-2.57 e)
  (if (null? (cdddr e))
      (caddr e)
      (cons '* (cddr e))))
(define (deriv-2.57 exp var)
  (cond ((number? exp) 0)
        ((variable? exp)
         (if (same-variable? exp var) 1 0))
        ((sum? exp)
         (make-sum (deriv-2.57 (addend exp) var)
                   (deriv-2.57 (augend-2.57 exp) var)))
        ((product? exp)
         (make-sum
          (make-product (multiplier exp)
                        (deriv-2.57 (multiplicand-2.57 exp) var))
          (make-product (deriv-2.57 (multiplier exp) var)
                        (multiplicand-2.57 exp))))
        ((exponentiation? exp)
         (make-product (exponent exp)
                       (make-product (make-expoinentiation (base exp)
                                                           (- (exponent exp) 1))
                                     (deriv-2.57 (base exp)
                                            var))))
        (else
         (error "unknown expression type -- DERIV" exp))))

(deriv-2.57 '(* x y (+ x 3)) 'x)
